Shareware Grab Bag/Shareware Grab Bag.iso/007/pctekap1.arc/TURBOIO.ARC/ANSISTUF.INC

Text File | 1985-08-17 | 24KB | 867 lines

(*
                          AnsiStuf.inc


    Dedicated to the public domain.
                -- Cole Brecheen
                   17 August 1985
*)

{$U-,C-,R-}{Enables keyboard buffering.}
{$V-} {Relaxes type checking on string parameters.}
{Depends on Dos2io-1.inc and Dos2io-2.inc.}

CONST
  GrafBdAddr = $B800; {segment address of color/graphics memory}
  MonoBdAddr = $B000; {segment address of memory on mono board}
  UnderCode = 'U';
  BoldCode = 'B';
  FlashCode = 'F';
  ReverseCode = 'R';
  PlainCode = 'P';

TYPE
  RegisterRecord = {record type used with Turbo's msdos function}
    RECORD
      case BOOLEAN of
    TRUE : (ax,bx,cx,dx,bp,si,di,ds,es,flags: INTEGER);
    FALSE: (al,ah,bl,bh,cl,ch,dl,dh     : BYTE);
      END;

  sc_TextAttribute = ( plain, bold, underscored, blinking,
               ReverseVideo, invisible );
  sc_ScreenMode    = ( BW40x25, color40x25, BW80x25, color80x25,
               color320, BW320, BW640, WrapAtEndOfLine );
  sc_AttributeSet  = set of sc_TextAttribute;

  VideoMethods = ( ANSI, ROM, DMA );

  VideoMemChar = record
           case boolean of
             true : ( ch: char; attr: byte );
             false: ( x: integer );
           end;

  AddrType = record {used in peek and poke routines}
           case integer of
         1: (r, s: integer); {seg and ofs values}
         2: (x: ^integer);
         3: (b: ^byte);
           end;

  ScreenType = record {used in saving and copying screens}
         width, size: integer;
         pntr: AddrType;
           end; {ScreenType}


VAR
  VideoMethod : VideoMethods; {initialized from "environment"}
  VidPtr : AddrType; {used for DMA video}
  MonoBdInstalled : boolean;
  PresentTextMode : sc_AttributeSet;
  PresentForeGround, PresentBackGround : integer;
    {To be used with Turbo's predefined color constants;
    see Turbo Pascal version 3.0 manual at 161}
  PresentScreenMode : sc_ScreenMode;
  AnsiInitKey : integer;
  sc_Maxcol, sc_MaxRow: integer;
    {We make these variables because they're capable of
    changing under software control.}
  NominalCol, NominalRow: integer;
    {We update these variables every time the cursor might
    move under ROM or ANSI but not under DMA.}


PROCEDURE sc_WriteStr( TheStr : dos2str80 );
VAR
  rgstr : RegisterRecord;
BEGIN
  insert( #27'[', TheStr, 1 );
  WITH rgstr DO BEGIN
    bx := 1; {sends all output to the screen}
    cx := ord( TheStr[0] );
    ds := seg( TheStr );
    dx := ofs( TheStr ) + 1;
    ah := $40;  {Write to a file or device command}
  END; {WITH rgstr}
  msdos( rgstr );
END;  {sc_WriteStr}



PROCEDURE CheckAnsiInitKey;
    {A prompt for the programmer, to be deleted when
    a program is complete.}
BEGIN {CheckAnsiInitKey}
    {4536 is an arbitrarily chosen value.}
  IF AnsiInitKey <> 4536 THEN
    abort('Please initialize with InitAnsiStuf.');
END; {CheckAnsiInitKey}



 PROCEDURE ReadWithoutEcho( VAR thestr : dos2str255 );
CONST backspace = 8;

  FUNCTION inkey: CHAR;
  VAR rgstr : RegisterRecord;
  BEGIN {inkey}
    REPEAT
      rgstr.ah := 8;
    {Non-echoing input from standard input device.}
      msdos( rgstr );
    UNTIL rgstr.al in [ backspace, 13, 32..127 ];
    {Means that only backspace, return, and printable
    characters will be recognized in ReadWithoutEcho.}
    inkey := chr(rgstr.al);
  END;  {inkey}

VAR bufch : CHAR;
BEGIN  {ReadWithoutEcho}
  thestr := null;
  REPEAT
    bufch := inkey;
    IF (bufch >= ' ') AND (bufch <= '~') THEN
      AddStr( thestr, bufch )
    ELSE
      IF (bufch = CHR( backspace )) AND ( length(TheStr) > 0 )
    THEN TheStr[0] := pred( TheStr[0] );
  UNTIL (bufch = CHR( 13 )) OR
    (length(thestr) >= (sizeof( thestr ) - 1) );
END; {ReadWithoutEcho}



PROCEDURE sc_CursorPosition( VAR column, row: INTEGER );
label EndProcedure;
TYPE str8 = string[8];
VAR
  ResultCode : INTEGER;
  rowstr, colstr, cpr : str8;
  rgstr: RegisterRecord;
BEGIN
  if VideoMethod <> ANSI then
    begin
      rgstr.ah := 3; {get cursor position}
      rgstr.bh := 0; {specifies display page}
      intr( $10, rgstr );
      column := rgstr.dl + 1;
      row := rgstr.dh + 1;
      goto EndProcedure;
    end;

  sc_WriteStr( '6n' );
      {The "Device Status Report" command.  See PC-DOS v2.0
      manual at 13-5.}
  ReadWithoutEcho( cpr );
  WHILE ( cpr[ 1 ] = chr( 27 ) )
    OR
    ( cpr[ 1 ] = '[' ) do delete( cpr, 1, 1 );
  val( copy(cpr,1,2), row, ResultCode );
  IF ResultCode <> 0
    THEN abort( cpr );
  val( copy(cpr,4,2), column, ResultCode );
  IF ResultCode <> 0
    THEN abort( cpr );
  EndProcedure:
END; {sc_CursorPosition}


function Between( min, x, max: integer ): integer;
begin {Between}
  if x < min then Between := min
  else if x > max then Between := max
       else Between := x;
end; {Between}


  PROCEDURE sc_GotoXY(column, row: INTEGER);
    {Same as Turbo's GotoXY.}
  var rgstr: RegisterRecord;
  BEGIN {sc_GotoXY}
    if VideoMethod = ANSI then
      sc_WriteStr( concat(IntStr(row, 0),';',
                  IntStr(column, 0),'H') )
    else
      with rgstr do begin
        ah := 2; {set-cursor-position function}
        bh := 0; {specifies display page}
        dh := Between( 0, row - 1, sc_MaxRow - 1 );
        dl := Between( 0, column - 1, sc_MaxCol - 1 );
        intr( $10, rgstr );
      end;
  END;  {sc_GotoXY}


  PROCEDURE sc_left;
    {Moves the cursor one space left.}
  var col, row: integer;
  BEGIN
    if VideoMethod = ANSI then
      sc_WriteStr( '1D' )
    else begin
      sc_CursorPosition( Col, Row );
      Col := Col - 1;
      gotoxy( Col, Row );
    end;
  END; {sc_left}

  PROCEDURE sc_right;
    {Moves the cursor one space right.}
  var col, row: integer;
  BEGIN
    if VideoMethod = ANSI then
      sc_WriteStr( '1C' )
    else begin
      sc_CursorPosition( Col, Row );
      Col := Col + 1;
      gotoxy( Col, Row );
    end;
  END; {sc_right}

  PROCEDURE sc_up;
    {Moves the cursor one row up.}
  var col, row: integer;
  BEGIN
    if VideoMethod = ANSI then
      sc_WriteStr( '1A' )
    else begin
      sc_CursorPosition( Col, Row );
      Row := Row - 1;
      gotoxy( Col, Row );
    end;
  END; {sc_up}

  PROCEDURE sc_down;
    {Moves the cursor one row down.}
  var col, row: integer;
  BEGIN
    if VideoMethod = ANSI then
      sc_WriteStr( '1B' )
    else begin
      sc_CursorPosition( Col, Row );
      Row := Row + 1;
      gotoxy( Col, Row );
    end;
  END; {sc_down}


procedure MonoAttrsToColor( AttrSet: sc_AttributeSet;
                    var foreground, background: integer );
label EndProcedure;
begin {MonoAttrsToColor}
  foreground := PresentForeGround;
  background := PresentBackGround;
  if invisible in AttrSet then begin
    foreground := black;
    background := black;
    goto EndProcedure;
  end;
  if plain in AttrSet then begin
    foreground := LightGray;
    background := black;
    goto EndProcedure;
  end;
  if underscored in AttrSet then begin
    foreground := blue;
    background := black;
  end;
  if ReverseVideo in AttrSet then begin
    foreground := black;
    background := LightGray;
  end;
  if bold in AttrSet then
    if PresentForeGround < DarkGray then
      foreground := PresentForeGround + DarkGray;
  if blinking in AttrSet then
    if VideoMethod <> DMA then begin
      if PresentForeGround < blink then
       foreground := PresentForeGround + blink;
    end
    else
      if PresentBackGround < (blink div 2) then
        background := PresentBackGround + (blink div 2);
  EndProcedure:
end; {MonoAttrsToColor}


procedure ColorToMonoAttrs( foreground, background : integer;
                   var AttrSet: sc_AttributeSet );
BEGIN {ColorToMonoAttrs}
  AttrSet := [plain];
  if (VideoMethod <> DMA) then
    begin
      if (foreground >= blink) then begin
        AttrSet := [blinking];
        foreground := foreground - blink
      end;
    end
  else
    if (background >= (blink div 2)) then begin
      AttrSet := [blinking];
      background := background - (blink div 2)
    end;
  if foreground >= DarkGray then begin
    AttrSet := AttrSet + [bold];
    foreground := foreground - DarkGray;
  end;
  case background of
    black : if foreground = blue then
          AttrSet := AttrSet + [underscored]
        else
          if foreground = black then
        AttrSet := [invisible];
    LightGray : if foreground = black then
          AttrSet := AttrSet + [ReverseVideo];
    else begin end;
  end;
  if AttrSet <> [plain] then
    AttrSet := AttrSet - [plain];
end; {ColorToMonoAttrs}


PROCEDURE sc_TextColor( foreground, background : integer );
BEGIN {sc_TextColor}
  CheckAnsiInitKey;
  IF foreground <> PresentForeGround THEN
    CASE VideoMethod of
      ANSI : sc_WriteStr( IntStr( foreground + 30, 2) + 'm' );
      ROM: TextColor( foreground );
      DMA: BEGIN END;
    END
  else PresentForeGround := foreground;

  IF background <> PresentBackGround THEN
    CASE VideoMethod of
      ANSI: sc_WriteStr( IntStr( foreground + 40, 2) +  'm' );
      ROM: TextBackground( background );
      DMA: BEGIN END;
    END
  else PresentBackGround := background;

  ColorToMonoAttrs( foreground, background, PresentTextMode );
END; {sc_TextColor}



PROCEDURE sc_TextMode( attribute : sc_TextAttribute );

  FUNCTION UpdateNeeded( attribute: sc_TextAttribute ): BOOLEAN;
  BEGIN {UpdateNeeded}
    UpdateNeeded := false;
    IF attribute = plain THEN
      begin
    IF PresentTextMode <> [plain] THEN
      UpdateNeeded := true;
    PresentTextMode := [plain];
      end
    ELSE
      IF not (attribute in PresentTextMode) THEN BEGIN
    PresentTextMode := PresentTextMode + [attribute] - [plain];
    UpdateNeeded := true;
      END;
  END; {UpdateNeeded}

VAR fground, bground: INTEGER;
BEGIN
  CheckAnsiInitKey;

  IF UpdateNeeded( attribute ) THEN
    if VideoMethod = ANSI then
      begin
(*  IF (attribute in [underscored, ReverseVideo]) and
       (WhereX = 1) THEN
      abort('WARNING:  default background may change.');
Reinsert if you encounter this problem in ANSI mode. *)
        CASE Attribute OF
          plain        : sc_WriteStr( '0m' );
          bold         : sc_WriteStr( '1m' );
          underscored  : sc_WriteStr( '4m' );
          blinking     : sc_WriteStr( '5m' );
          ReverseVideo : sc_WriteStr( '7m' );
          invisible    : sc_WriteStr( '8m' );
        END {CASE}
      end
    else
      begin
        MonoAttrsToColor( PresentTextMode, fground, bground );
        sc_TextColor( fground, bground );
      end;
        MonoAttrsToColor( PresentTextMode,
              PresentForeGround,
              PresentBackGround );
END;  {sc_TextMode}


PROCEDURE sc_ScrnMode( TheMode: sc_ScreenMode );
BEGIN {sc_ScrnMode}
  CheckAnsiInitKey;
  IF TheMode <> PresentScreenMode THEN
    BEGIN
      if VideoMethod = ANSI then
    sc_WriteStr( '=' + IntStr(ord(TheMode),1) +  'h' )
      else
    if TheMode <= Color80x25 then
      TextMode( ord(TheMode) )
    else
      case TheMode of
        color320 : GraphColorMode;
        BW320 : GraphMode;
        BW640 : begin
                  HiRes;
                  HiResColor( ord(PresentForeGround) );
                end;
      end; {case}
      PresentScreenMode := TheMode;
    END;
END; {sc_ScrnMode}


function PeekWord( segm, offs: integer ): integer;
var TmpPtr: AddrType;
begin {PeekWord}
  TmpPtr.s := segm;
  TmpPtr.r := offs;
  PeekWord := TmpPtr.x^;
end; {PeekWord}


procedure PokeWord( TheWord: integer; segm, offs: integer );
var TmpPtr: AddrType;
begin {PokeWord}
  TmpPtr.s := segm;
  TmpPtr.r := offs;
  TmpPtr.x^ := TheWord;
end; {PokeWord}


function PeekByte( segm, offs: integer ): byte;
var TmpPtr: AddrType;
begin {PeekByte}
  TmpPtr.s := segm;
  TmpPtr.r := offs;
  PeekByte := TmpPtr.b^;
end; {PeekByte}


procedure PokeByte( TheByte: byte; segm, offs: integer );
var TmpPtr: AddrType;
begin {PokeByte}
  TmpPtr.s := segm;
  TmpPtr.r := offs;
  TmpPtr.b^ := TheByte;
end; {PokeByte}

function ShiftL( TheNum, places: integer ): integer;
begin {ShiftL}
  ShiftL := TheNum shl places;
    {We do this to insulate Turbo's non-standard
    syntax so the code will work with other compilers.
    You may have to rewrite shl using multiplication.}
end; {ShiftL}


function coord( ColNum, RowNum: byte ): integer;
    {Makes it easier to work with the routines below, which
    treat the screen as a linear sequence of 4000 bytes.}
begin {coord}
  coord := Between(0, RowNum - 1, sc_MaxRow - 1) * sc_MaxCol +
       Between(1, ColNum, sc_MaxCol);
end; {coord}


procedure ReadVidCh( spot: integer;
             var TheChar: VideoMemChar );
var rgstr: RegisterRecord;
begin {ReadVidCh}
  NominalCol := spot mod sc_MaxCol;
  NominalRow := (spot div sc_MaxCol) + 1;
  case VideoMethod of
    DMA: TheChar.x := PeekWord( VidPtr.s,
                        VidPtr.r + (spot * 2) - 2 );
    ROM: begin
      gotoxy( NominalCol, NominalRow );
      with rgstr do begin
        ah := 8; {reads char and attribute at cursor position}
        bx := 0; {specifies the display page}
        intr( $10, rgstr );
        TheChar.ch := chr( al );
        TheChar.attr := ah;
      end; {with rgstr}
    end;
    {We don't have an else because no PC/MS-DOS screen-reading
    function exists.}
  end; {case}
end; {ReadVidCh}


procedure WriteVidCh( spot: integer;
             TheChar: VideoMemChar );
var rgstr: RegisterRecord;
begin {WriteVidCh}
  NominalCol := spot mod sc_MaxCol;
  NominalRow := (spot div sc_MaxCol) + 1;
  case VideoMethod of
    DMA: PokeWord( TheChar.x,
           VidPtr.s,
           VidPtr.r + (spot * 2) - 2 );
    ROM: begin
      gotoxy( NominalCol, NominalRow );
      with rgstr do begin
        ah := 9; {write char and attribute}
        bh := 0; {display page}
        cx := 1; {number of chars to write}
        al := ord(TheChar.ch);
        bl := TheChar.attr;
        intr( $10, rgstr );
      end; {with}
    end; {ROM}
    else begin
      sc_gotoxy( NominalCol, NominalRow );
      WriteStr( outp, TheChar.ch );
    end;
  end; {case}
end; {WriteVidCh}


function RealVideoMode: sc_ScreenMode;
var rgstr: RegisterRecord;
begin {RealVideoMode}
  MonoBdInstalled := false;
  with rgstr do begin
    ah := 15; {function that reads current video mode}
    intr( $10, rgstr ); {performs an Interrupt 10H }
    case al of
      0: RealVideoMode := BW40x25;
      1: RealVideoMode := Color40x25;
      2: RealVideoMode := BW80x25;
      3: RealVideoMode := Color80x25;
      4: RealVideoMode := Color320;
      5: RealVideoMode := BW320;
      6: RealVideoMode := BW640;
      7: begin
       RealVideoMode := BW80x25;
       MonoBdInstalled := true;
     end;
      else abort( 'Mode unknown to ANSI.SYS.' );
    end; {case}
    sc_MaxCol := ah;
    sc_MaxRow := 25;
  end; {with rgstr}
end; {RealVideoMode}


procedure WriteAt( ColNum, RowNum: byte; TheStr: dos2str255 );
var
  BufChar: VideoMemChar;
  VidMemSpot: integer;
  endstr, cnt : byte;
begin {WriteAt}
  CheckAnsiInitKey;
  endstr := length( TheStr );
  NominalCol := ColNum + endstr;
  NominalRow := RowNum;
  case VideoMethod of
    DMA:
      begin
        BufChar.attr := PresentForeGround or
                    ShiftL(PresentBackGround, 4);
        VidMemSpot := coord( ColNum, RowNum );
        for cnt := 1 to endstr do begin
          BufChar.ch := TheStr[ cnt ];
          PokeWord( BufChar.x, VidPtr.s,
                (VidMemSpot + cnt - 1) * 2 - 2 );
        end; {for}
      end; {DMA}
    ROM :
      begin
        gotoxy( ColNum, RowNum );
        write( TheStr );
      end; {ROM}
    ANSI :
      begin
        sc_gotoxy( ColNum, RowNum );
        WriteStr( outp, TheStr );
      end;
  end; {case}
end; {WriteAt}


procedure CursorHeight( lines: byte );
label EndProcedure;
var rgstr: RegisterRecord;
begin {CursorHeight}
  if VideoMethod = ANSI then goto EndProcedure;
  with rgstr do begin
    ah := 1; {set-cursor-type function}
    if MonoBdInstalled then
      cl := 13 {monochrome bd's cursor has 13 lines, maximum}
    else cl := 7; {color bd's has 7}
    if lines = 0 then
      ch := 32  {turns off cursor}
    else if lines > 13 then
       ch := lines
     else ch := cl - lines + 1;
    intr( $10, rgstr );
  end; {with rgstr}
  EndProcedure:
end; {CursorHeight}


var SavedCol, SavedRow: integer;

  PROCEDURE sc_SaveCursorPosition;
    {For temporary storage of a cursor position.}
  BEGIN {sc_SaveCursorPosition}
    if VideoMethod = ANSI then
      sc_WriteStr( 's' )
    else
      sc_CursorPosition( SavedCol, SavedRow );
  END; {sc_SaveCursorPosition}

  PROCEDURE sc_RestoreCursorPosition;
  BEGIN {sc_RestoreCursorPosition}
    if VideoMethod = ANSI then
      sc_WriteStr( 'u' )
    else
      gotoxy( SavedCol, SavedRow );
  END; {sc_RestoreCursorPosition}


PROCEDURE sc_ClrPart( col1, row1, col2, row2: integer );
VAR
  horizdistance, vertdistance, VertCnt : INTEGER;
  clearstring : dos2str255;
  rgstr : RegisterRecord;
BEGIN  {sc_ClrPart}
  if VideoMethod = ANSI then
    begin
      horizdistance := Between( 0, col2 - col1 + 1, sc_MaxCol );
      vertdistance := Between( 0, row2 - row1 + 1, sc_MaxRow );
      fillchar( clearstring, horizdistance + 1, ' ' );
      clearstring[ 0 ] := chr(horizdistance);
      for VertCnt := 0 to vertdistance DO BEGIN
        sc_GotoXY( col1, row1 + VertCnt );
        WriteStr( outp, clearstring );
      END;  {FOR}
    end
  else {VideoMethod = ROM or DMA}
    with rgstr do begin
      ah := 6; {scroll active page up function}
      al := 0; {means blank entire window}
      ch := row1 - 1; cl := col1 - 1;
      dh := row2 - 1; dl := col2 - 1;
      bh := PresentForeGround or ShiftL(PresentBackGround, 4);
      intr( $10, rgstr );
    end; {with}
  sc_gotoxy( col1, row1 );
END;  {sc_ClrPart}


  PROCEDURE sc_ClrScr;
    {Clears the screen and sends the cursor to the top left
    corner.}
  BEGIN
    if VideoMethod = ANSI then
      sc_WriteStr( '2J' )
    else
      sc_ClrPart( 1,1, sc_MaxCol,sc_MaxRow );
  END; {sc_ClrScr}

  PROCEDURE sc_ClrEol(column,row:INTEGER);
  BEGIN  {sc_ClrEol}
    sc_GotoXY( column, row );
    if VideoMethod = ANSI then
      sc_WriteStr( 'K' )
    {The PC-DOS v2.0 manual erroneously lists a lower case k
    for this function.}
    else
      sc_ClrPart( column,row, sc_MaxCol,row );
  END;  {sc_ClrEol}

PROCEDURE sc_scrollwindow( col1, row1, col2, row2, lines: integer );
VAR
  rgstr : RegisterRecord;
BEGIN  {sc_scrollwindow}
  if VideoMethod = ANSI then abort(
'Before restarting this program type: set videomethod=dma')
  else {VideoMethod = ROM or DMA}
  IF lines <> 0 THEN
  BEGIN
    with rgstr do begin
      IF lines < 0 then ah := 7 {scroll active page down function}
        ELSE ah := 6; {scroll up}
      al := abs(lines); {no. of lines to scroll}
      ch := row1 - 1; cl := col1 - 1;
      dh := row2 - 1; dl := col2 - 1;
      bh := PresentForeGround or ShiftL(PresentBackGround, 4);
      intr( $10, rgstr );
    end; {with}
  END; {IF lines <> 0}
END;  {sc_scrollwindow}

procedure ScrnSave( var scrn: ScreenType;
            col1, row1, col2, row2: integer );
var
  cnt, row, col: integer;
  BufCh: VideoMemChar;
begin {ScrnSave}
  if VideoMethod = ROM then
    begin
      CursorHeight(0); {turns off cursor}
      sc_SaveCursorPosition;
    end;
  with scrn do begin
    width := Between( 1, col2 - col1 + 1, sc_MaxCol );
    size := width * Between( 1, row2 - row1 + 1, sc_MaxRow ) * 2;
    {It's *2 to make room for attribute bytes.}
    if (MaxAvail * 16.0) < (1.0 * size) then
      abort( 'Too little memory to save screen.' );
    GetMem( pntr.x, size );
    cnt := 0;
    for row := row1 to row2 do begin
      for col := col1 to col2 do begin
    ReadVidCh( coord(col, row), BufCh );
    PokeWord( BufCh.x, pntr.s, pntr.r + cnt );
    cnt := cnt + 2;
      end; {for col}
    end; {for row}
  end; {with}
  if VideoMethod = ROM then
    begin
      CursorHeight(2); {restores cursor}
      sc_RestoreCursorPosition;
    end;
end; {ScrnSave}


procedure ScrnRestore( scrn: ScreenType; col, row: integer );
var
  x, y, cnt: integer;
  BufCh: VideoMemChar;
begin {ScrnRestore}
  if VideoMethod = ROM then
    begin
      CursorHeight(0); {turns off cursor}
      sc_SaveCursorPosition;
    end;
  with scrn do begin
    cnt := 0;
    while cnt < size do begin
      BufCh.x := PeekWord( pntr.s, pntr.r + cnt );
      x := ((cnt div 2) mod width) + col;
      y := ((cnt div 2) div width) + row;
      if (x <= sc_MaxCol) and (y <= sc_MaxRow) then
    WriteVidCh( (y - 1) * sc_MaxCol + x, BufCh );
      cnt := cnt + 2;
    end; {for}
    FreeMem( pntr.x, size );
  end; {with}
  if VideoMethod = ROM then
    begin
      CursorHeight(2); {restores cursor}
      sc_RestoreCursorPosition;
    end;
end; {ScrnRestore}


PROCEDURE ReassignKey( KeyCode: INTEGER;
               Extended: BOOLEAN;
               NewDefn: dos2str80 );
BEGIN {ReassignKey}
  IF Extended
    THEN sc_WriteStr( '0;' + IntStr( KeyCode, 0 ) +
              ';' + NewDefn + 'p' )
    ELSE sc_WriteStr( IntStr( KeyCode, 0 ) +
              ';' + NewDefn + 'p' );
    {Doing this independent of ANSI.SYS is too
    difficult.  We leave it unimplemented for
    non-ANSI I/O.}
END; {ReassignKey}


procedure ReadEnvironment( name: dos2str80; var parameter: dos2str80 );
var
  bufch : char;
  tmpcopy: dos2str80;
  found: boolean;
  EnvSeg, EnvNdx, cnt, EqSpot: integer;
begin  {ReadEnvironment}
  EnvSeg := PeekWord( Cseg, $2C );
    {Get segment address of the environment from PSP.}
  found := false;
  parameter := null;
  EnvNdx := 0;
  for cnt := 1 to length( name ) do
    name[cnt] := UpCase( name[cnt] );
  repeat
    tmpcopy := null;
    bufch := chr( PeekByte(EnvSeg, EnvNdx) );
    while bufch <> chr(0) do begin
      AddStr( tmpcopy, UpCase( bufch ) );
      EnvNdx := EnvNdx + 1;
      bufch := chr( PeekByte(EnvSeg, EnvNdx) );
    end; {while}
    if pos( name, tmpcopy ) = 1 then
      begin
    EqSpot := pos( '=', tmpcopy );
    if EqSpot > 0 then
      begin
        parameter := copy( tmpcopy,
                       EqSpot + 1,
                       length(tmpcopy) - EqSpot );
        found := true;
      end;
      end;
    EnvNdx := EnvNdx + 1;
    if PeekByte(EnvSeg, EnvNdx) = 0 then
      found := true;
  until found;
  while pos(' ', parameter) = 1 do delete(parameter,1,1);
end; {ReadEnvironment}


PROCEDURE InitAnsiStuf;
VAR
  setting : dos2str80;
BEGIN {InitAnsiStuf}
  ReadEnvironment( 'VideoMethod', setting );
  if setting = 'DMA' then
    VideoMethod := DMA
  else
    if setting = 'ROM' then
      VideoMethod := ROM
    else
      VideoMethod := ANSI;

  PresentForeGround := LightGray;
  PresentBackGround := black;
  PresentTextMode := [plain];

  if VideoMethod = ANSI then
    begin
      sc_WriteStr( '0m' ); {sets text mode to plain}
      PresentScreenMode := BW80x25;
      sc_MaxCol := 80;
      sc_MaxRow := 25;
    end
  else
    begin
      LowVideo;
      TextColor( LightGray );
      TextBackGround( black );
    {We have to set these colors so that AnsiStuf variables
    will be able to track text attributes and prevent
    needless interrupts.}
      PresentScreenMode := RealVideoMode;
      if MonoBdInstalled then
    VidPtr.s := MonoBdAddr
      else
    VidPtr.s := GrafBdAddr;
      VidPtr.r := 0;
    end;
  AnsiInitKey := 4536; {an arbitrarily chosen value}
END; {InitAnsiStuf}